home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / misc / emu / listSHK.lha / listSHK.p < prev    next >
Encoding:
Text File  |  1998-03-05  |  6.6 KB  |  265 lines
  1. program listSHK;
  2.  
  3. type str4 = string[4];
  4.      thread = record
  5.                 cl: integer;
  6.                 sA,
  7.                 sB: long
  8.               end;
  9.  
  10. var headerFound: Boolean;
  11.     b1, b2, b3, b4, b5, b6: byte;
  12.     attribCount, versNo, storageType, class, i, j: integer;
  13.     fileCount, totalThreads, fileType, extraType, sizeA, sizeB, iL: long;
  14.     K2, id1, id2: str4;
  15.     K1: string[6];
  16.     fileName: string[32];
  17.     a: file of byte;
  18.     threads: array[1..32] of thread;
  19.     months: array[0..11] of string[3];
  20.  
  21. function toWord: integer;
  22.   begin
  23.     toWord := ord(b2) shl 8 + ord(b1)
  24.   end;
  25.  
  26. function toLong: long;
  27.   begin
  28.     toLong := long(b4) shl 24 + long(b3) shl 16 + b2 shl 8 + b1
  29.   end;
  30.  
  31. procedure ShowDate;
  32.   begin
  33.     if b1 + b2 + b3 = 0
  34.         then write('[No Date]')
  35.       else write(b3 + 1:2, '-', months[b2], '-', b1:2);
  36.     writeln('  ', b6:2, ':', b5:2, ':', b4:2)
  37.   end;
  38.  
  39. begin
  40.   K1 := 'N' + #$F5 + 'F' + #$E9 + 'l' + #$E5;  { 'NuFile' }
  41.   K2 := 'N' + #$F5 + 'F' + #$D8;  { 'NuFx' }
  42.   months[0] := 'Jan';
  43.   months[1] := 'Feb';
  44.   months[2] := 'Mar';
  45.   months[3] := 'Apr';
  46.   months[4] := 'Mar';
  47.   months[5] := 'Jun';
  48.   months[6] := 'Jul';
  49.   months[7] := 'Aug';
  50.   months[8] := 'Sep';
  51.   months[9] := 'Oct';
  52.   months[10] := 'Nov';
  53.   months[11] := 'Dec';
  54.   if ParamCount <> 1
  55.       then begin
  56.         writeln('Usage: listSHK pathname');
  57.         halt(20)
  58.       end
  59.     else fileName := ParamStr(1) + '.SHK';
  60.   assign(a, fileName);
  61.   reset(a);
  62.   if eof(a)
  63.       then begin
  64.         writeln('Could not find ''', fileName, '''');
  65.         halt(20)
  66.       end
  67.   writeln;
  68.   read(a, b1, b2, b3, b4, b5, b6);
  69.   if chr(b1) + chr(b2) + chr(b3) + chr(b4) + chr(b5) + chr(b6) <> K1
  70.       then begin
  71.         writeln('Invalid master header!');
  72.         close(a);
  73.         halt(20)
  74.       end;
  75.  
  76.   { *** for now, skip master header CRC *** }
  77.   for i := 1 to 2
  78.     do read(a, b1);
  79.  
  80.   read(a, b1, b2, b3, b4);
  81.   fileCount := toLong;
  82.  
  83.   { *** for now, skip rest of master header *** }
  84.   for i := 1 to 36
  85.     do read(a, b1);
  86.  
  87.   while fileCount > 0
  88.     do begin
  89.  
  90.       read(a, b1, b2, b3, b4);
  91.       if chr(b1) + chr(b2) + chr(b3) + chr(b4) <> K2
  92.           then begin
  93.             writeln('Invalid header!');
  94.             close(a);
  95.             halt(20)
  96.           end;
  97.  
  98.       { *** for now, skip header CRC *** }
  99.       read(a, b1, b2);
  100.  
  101.       read(a, b1, b2);
  102.       attribCount := toWord;
  103. {
  104. writeln('Number of attribute bytes = ', attribCount)
  105. }
  106.       read(a, b1, b2);
  107.       versNo := toWord;
  108. {
  109. writeln('Version number needed = ', versNo)
  110. }
  111.       read(a, b1, b2, b3, b4);
  112.       totalThreads := toLong;
  113. {
  114. writeln('Threads = ',totalThreads)
  115. }
  116.       { *** for now, skip three fields *** }
  117.       for i := 1 to 8
  118.         do read(a, b1);
  119.  
  120.       read(a, b1, b2, b3, b4);
  121.       fileType := toLong;
  122. writeln('File type = ', fileType)
  123.  
  124.       read(a, b1, b2, b3, b4);
  125.       extraType := toLong;
  126. writeln('Extra type = ', extraType)
  127.  
  128.       read(a, b1, b2);
  129.       storageType := toWord;
  130. writeln('Storage type = ', storageType)
  131.  
  132.       read(a, b4, b5, b6, b1, b2, b3);
  133.       write('Created:  ');
  134.       ShowDate;
  135.       read(a, b1, b2);
  136.  
  137.       read(a, b4, b5, b6, b1, b2, b3);
  138.       write('Modified: ');
  139.       ShowDate;
  140.       read(a, b1, b2);
  141.  
  142.       read(a, b4, b5, b6, b1, b2, b3);
  143.       write('Archived: ');
  144.       ShowDate;
  145.       read(a, b1, b2);
  146.  
  147.       if versNo = 0
  148.           then begin
  149.             read(a, b1, b2, b3, b4, b5, b6);
  150.             read(a, b1, b2);
  151.             sizeA := toWord;
  152.             write('File name is ''');
  153.             for iL := 1 to sizeA
  154.               do begin
  155.                 read(a, b1);
  156.                 write(chr(b1))
  157.               end;
  158.             writeln('''');
  159.           end
  160.         else read(a, b1, b2, b3, b4);
  161.  
  162.       for i := 1 to totalThreads
  163.         do begin
  164. {
  165.           writeln('Thread ', i, ':');
  166. }
  167.           read(a, b1, b2);
  168.           class := toWord;
  169.           threads[i].cl := class;
  170.           case class of
  171.               0,
  172.               2,
  173.               3: begin
  174.                    for j := 1 to 6
  175.                      do read(a, b1);
  176.                    read(a, b1, b2, b3, b4);
  177.                    sizeA := toLong;
  178.                    read(a, b1, b2, b3, b4);
  179.                    sizeB := toLong;
  180. {
  181. writeln(sizeA:6, sizeB:6)
  182. }
  183.                    threads[i].sA := sizeA;
  184.                    threads[i].sB := sizeB
  185.                  end;
  186.             else begin
  187.               for j := 1 to 14
  188.                 do read(a, b1);
  189.               writeln('Found class ', class, ' in thread ', i);
  190.               writeln('Aborting!');
  191.               close(a);
  192.               halt(20)
  193.             end
  194.           end
  195.         end;
  196.       for i := 1 to totalThreads
  197.         do begin
  198.           sizeA := threads[i].sA;
  199.           sizeB := threads[i].sB;
  200.           case threads[i].cl of
  201.             3: begin
  202.                  write('File name is ''');
  203.                  for iL := 1 to sizeA
  204.                    do begin
  205.                      read(a, b1);
  206.                      write(chr(b1))
  207.                    end;
  208.                  writeln('''');
  209.                  if sizeA < sizeB
  210.                      then for iL := 1 to sizeB - sizeA
  211.                             do read(a, b1)
  212.                end;
  213.             0: begin
  214.                  if sizeA > 0
  215.                      then begin
  216.                        writeln('Message is:');
  217.                        write('    ');
  218.                        for iL := 1 to sizeA
  219.                          do begin
  220.                            read(a, b1);
  221.                            if b1 = 13
  222.                                then begin
  223.                                  writeln;
  224.                                  write('    ')
  225.                                end
  226.                              else write(chr(b1))
  227.                          end;
  228.                        writeln
  229.                      end;
  230.                  if sizeA < sizeB
  231.                      then for iL := 1 to sizeB - sizeA
  232.                             do read(a, b1)
  233.                end;
  234.             2: begin
  235.                  for iL := 1 to sizeB
  236.                    do read(a, b1)
  237.                end
  238.           end
  239.         end;
  240.       writeln;
  241.       fileCount := fileCount - 1
  242.     end;
  243.   close(a)
  244. end.
  245. { Old logic to scan for file header record
  246.       headerFound := false;
  247.       repeat
  248.         read(a, b1);
  249.         if chr(b1) = K2[1]
  250.             then begin
  251.               read(a, b2);
  252.               if chr(b2) = K2[2]
  253.                   then begin
  254.                     read(a, b3);
  255.                     if chr(b3) = K2[3]
  256.                         then begin
  257.                           read(a, b4);
  258.                           if chr(b4) = K2[4]
  259.                               then headerFound := true
  260.                         end
  261.                   end
  262.             end
  263.       until headerFound;
  264. }
  265.